home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DOS.SWG / 0027_DOS Volume Labels.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  4KB  |  189 lines
  1. {
  2. > I need a way to find the  volume Label of a drive.  Any  suggestions or
  3. > source code?
  4. }
  5. {$S-,R-,V-,I-,N-,B-,F-}
  6.  
  7. Unit Volume;
  8.  
  9. Interface
  10.  
  11. Uses
  12.   Dos;
  13.  
  14. Type
  15.  
  16.   Drive       = Byte;
  17.   VolumeName  = String [11];
  18.  
  19.   VolFCB      = Record
  20.     FCB_Flag : Byte;
  21.     Reserved : Array [1..5] of Byte;
  22.     FileAttr : Byte;
  23.     Drive_ID : Byte;
  24.     FileName : Array [1..8] of Byte;
  25.     File_Ext : Array [1..3] of Byte;
  26.     Unused_A : Array [1..5] of Byte;
  27.     File_New : Array [1..8] of Byte;
  28.     fExt_New : Array [1..3] of Byte;
  29.     Unused_B : Array [1..9] of Byte
  30.   end;
  31.  
  32. Function DelVol (D : Byte) : Boolean;
  33. Function AddVol (D : Byte; V : VolumeName) : Boolean;
  34. Function ChgVol (D : Byte; V : VolumeName) : Boolean;
  35. Function GetVol (D : Byte) : VolumeName;
  36.  
  37. Implementation
  38.  
  39. Procedure Pad_Name (Var V : VolumeName);
  40. begin
  41.   While LENGTH (V) <> 11 DO
  42.     V := V + ' '
  43. end;
  44.  
  45. Function Fix_Ext_Sym (Var V : VolumeName) : Byte;
  46. Var
  47.   I : Byte;
  48. begin
  49.   I := POS ('.', V);
  50.   if I > 0 then
  51.     DELETE (V, I, 1);
  52.   Fix_Ext_Sym := I
  53. end;
  54.  
  55. Function Extract_Name (S : SearchRec) : VolumeName;
  56. Var
  57.   H, I : Byte;
  58. begin
  59.   I := Fix_Ext_Sym (S.Name);
  60.   if (I > 0) and (I < 9) then
  61.     For H := 1 to (9 - I) DO
  62.       INSERT (' ', S.Name, I);
  63.   Extract_Name := S.Name
  64. end;
  65.  
  66. Procedure Fix_Name (Var V : VolumeName);
  67. Var
  68.   I : Byte;
  69. begin
  70.   Pad_Name (V);
  71.   For I := 1 to 11
  72.     do V [I] := UPCASE (V [I])
  73. end;
  74.  
  75. Function Valid_Drive_Num (D : Byte) : Boolean;
  76. begin
  77.   Valid_Drive_Num := (D >= 1) and (D <= 26)
  78. end;
  79.  
  80. Function Find_Vol (D : Byte; Var S : SearchRec) : Boolean;
  81. begin
  82.   FINDFIRST (CHR (D + 64) + ':\*.*', VolumeID, S);
  83.   Find_Vol := DosError = 0
  84. end;
  85.  
  86. Procedure Fix_FCB_NewFile (V : VolumeName; Var FCB : VolFCB);
  87. Var
  88.   I : Byte;
  89. begin
  90.   For I := 1 to 8 DO
  91.     FCB.File_New [I] := ORD (V [I]);
  92.   For I := 1 to 3 DO
  93.     FCB.fExt_New [I] := ORD (V [I + 8])
  94. end;
  95.  
  96. Procedure Fix_FCB_FileName (V : VolumeName; Var FCB : VolFCB);
  97. Var
  98.    I : Byte;
  99. begin
  100.   For I := 1 to 8 DO
  101.     FCB.FileName [I] := ORD (V [I]);
  102.   For I := 1 to 3 DO
  103.     FCB.File_Ext [I] := ORD (V [I + 8])
  104. end;
  105.  
  106. Function Vol_Int21 (Fnxn : Word; D : Drive; Var FCB : VolFCB) : Boolean;
  107. Var
  108.   Regs : Registers;
  109. begin
  110.   FCB.Drive_ID := D;
  111.   FCB.FCB_Flag := $FF;
  112.   FCB.FileAttr := $08;
  113.   Regs.DS     := SEG (FCB);
  114.   Regs.DX     := OFS (FCB);
  115.   Regs.AX     := Fnxn;
  116.   MSDos (Regs);
  117.   Vol_Int21 := Regs.AL = 0
  118. end;
  119.  
  120. Function DelVol (D : Byte) : Boolean;
  121. Var
  122.    sRec : SearchRec;
  123.    FCB  : VolFCB;
  124.    V    : VolumeName;
  125. begin
  126.   DelVol := False;
  127.   if Valid_Drive_Num (D) then
  128.   begin
  129.     if Find_Vol (D, sRec) then
  130.     begin
  131.       V := Extract_Name (sRec);
  132.       Pad_Name (V);
  133.       Fix_FCB_FileName (V, FCB);
  134.       DelVol := Vol_Int21 ($1300, D, FCB)
  135.     end
  136.   end
  137. end;
  138.  
  139. Function AddVol (D : Byte; V : VolumeName) : Boolean;
  140. Var
  141.   sRec : SearchRec;
  142.   FCB  : VolFCB;
  143. begin
  144.   AddVol := False;
  145.   if Valid_Drive_Num (D) then
  146.   begin
  147.     if not Find_Vol (D, sRec) then
  148.     begin
  149.       Fix_Name (V);
  150.       Fix_FCB_FileName (V, FCB);
  151.       AddVol := Vol_Int21 ($1600, D, FCB)
  152.     end
  153.   end
  154. end;
  155.  
  156. Function ChgVol (D : Byte; V : VolumeName) : Boolean;
  157. Var
  158.    sRec : SearchRec;
  159.    FCB  : VolFCB;
  160.    x    : Byte;
  161. begin
  162.   ChgVol := False;
  163.   if Valid_Drive_Num (D) then
  164.   begin
  165.     if Find_Vol (D, sRec) then
  166.     begin
  167.       x := Fix_Ext_Sym (V);
  168.       Fix_Name (V);
  169.       Fix_FCB_NewFile (V, FCB);
  170.       V := Extract_Name (sRec);
  171.       Pad_Name (V);
  172.       Fix_FCB_FileName (V, FCB);
  173.       ChgVol := Vol_Int21 ($1700, D, FCB)
  174.     end
  175.   end
  176. end;
  177.  
  178. Function GetVol (D : Byte) : VolumeName;
  179. Var
  180.   sRec : SearchRec;
  181. begin
  182.   GetVol := '';
  183.   if Valid_Drive_Num (D) then
  184.     if Find_Vol (D, sRec) then
  185.       GetVol := Extract_Name (sRec)
  186. end;
  187.  
  188. end.
  189.